perm filename FILL.FAI[NEW,LCS]2 blob sn#152808 filedate 1975-03-30 generic text, type T, neo UTF8
00100		TITLE FILL
00200		ENTRY FILLER,LINES
00400		DEFINE FLOAT(N)
00500	   <	TLC N,232000
00600		FADR N,N   >
00700		DEFINE FIXX(N)
00800	  <	JUMPGE	N,.+5
00850		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01400	
01500		KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01600		RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01700		HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01800	
01900					;	SUBROUTINE FILLER(Q,M)
02000	FILLER:	0
02100		MOVEM 16,SV16#
02200		HRRZ J,(16)
02300		HRRZM J,SVQ#
02400		HRRZ T,@1(16)
02500		HRRZM T,SVM#		;	KK=NE(1)
02600		HRRZ KK,2(J)
02700		ADDI KK,-1(J)
02800					;	DO 4 K=2,KK
02900		HRRZI L,2(J)
03000					;	IF(NE(K).NE.3)GO TO 11
03100	L4:	ADDI L,3
03200		HRRZ T,(L)
03300	L11:	SETZM (L)
03400		CAIN T,3
03500					;	NE(K)=-1
03600	      	SETOM (L)
03700					;	GO TO 4
03800					; 11	NE(K)=0
03900					; 4	CONTINUE
04000		CAIGE L,(KK)
04100		JRST L4
04200					;	RLFT=10000
04300		MOVE RL,[=10000.0]
04400					;	RT=-10000
04500		MOVN RJ,[=10000.0]
04600					;	B=RT
04700		MOVE B,RJ
04800					;	DO 12 K=1,KK
04900		HRRZI L,-3(J)
05000					;	H=IFIX(Q(K))
05100	L12:	ADDI L,3
05200		MOVE H,(L)
05300		FIXX(H)
05400		FLOAT(H)
05500					;	IF(H.LT.RLFT)RLFT=H
05600		CAMGE H,RL
05700		MOVE RL,H
05800	
05900					;	IF(H.GT.RT)RT=H
06000		CAMLE H,RJ
06100		MOVE RJ,H
06200					;	IF(H.EQ.B)NE(K)=-1
06300		CAMN H,B
06400		SETOM 2(L)
06500					;	B=H
06600		MOVE B,H
06700					;	Q(K)=H
06800		MOVEM H,(L)
06900					; 12    R(K)=IFIX(R(K))
07000		MOVE T,1(L)
07100		FIXX(T)
07200		FLOAT(T)
07300		MOVEM T,1(L)
07400		CAIGE L,-2(KK)
07500		JRST L12
07600					;	NE(KK+1)=-1
07700		SETOM 3(KK)
07800	
07900					;	LRT=RT
08000		FIXX(RJ)
08100		MOVEM RJ,LRT#
08200					;	JA=3
08300		HRRZI T,3
08400		HRRZM T,JA#
08500	
08600	
08700					; 124   LEFT=RLFT
08800	L124:	MOVE LE,RL
08900		FIXX(LE)
09000					; 51    J=LEFT
09100	L51:	MOVE J,LE
09200					; 42    RJ=J+.001
09300	L42:	MOVE RJ,J
09400		FLOAT(RJ)
09500		FADR RJ,[=0.001]
09600					;	JCONT=0
09700		SETZM JCONT#
09800					;	LEFT=J
09900		MOVE LE,J
10000	
10100					;	JJ=-1
10200		SETO JJ,
10300					;	ALT=-10000.
10400		MOVN AL,[=10000.0]
10500					; 200   DO 45 L=2,KK
10600		HRRZ L,SVQ
10700	L45:	ADDI L,3
10800		CAILE L,-2(KK)
10900		JRST L455
11000					;	IF(NE(L).NE.0)GO TO 45
11100		SKIPE 2(L)
11200		JRST L45
11300					;	IF(MISS(L,RJ,Q))GO TO 45
11400		CAML RJ,-3(L)
11500		JRST L201
11600		CAMLE RJ,(L)
11700		JRST L202
11800	L201:	CAMGE RJ,(L)
11900		CAMG RJ,-3(L)
12000		JRST L45
12100					;	H=HGHT(L,RJ,Q,R)
12200	L202:	MOVE H,-2(L)
12300		CAMN H,1(L)
12500		JRST RET
12550		MOVNS H
12700		FADR H,1(L)
12750		MOVE D,-3(L)
12800		MOVNS T,D
12900		FADR T,RJ
13000		FADR D,(L)
13100		FMPR H,T
13200		FDVR H,D
13300		FADR H,-2(L)
13400					;	IF(H.LT.ALT)GO TO 45
13500	RET:	CAMGE H,AL
13600		JRST L45
13700	
13800					;	ALT=H
13900		MOVE AL,H
14000					;	JJ=L
14100		HRRZI JJ,(L)
14200					; 45    CONTINUE
14300		JRST L45
14400					;	IF(JJ)GO TO 43
14500	L455:	JUMPL JJ,L43
14600					;	JCONT=-1
14700		SETOM JCONT
14800					;	LEFT=J
14900		MOVE LE,J
15000					; 46    JA=3
15100	L46:	HRRZI T,3
15200		HRRZM T,JA
15300					;	JORD=-1
15400		SETOM JORD#
15500					; 52    KN=Q(JJ)
15600	L52:	MOVE T,(JJ)
15700		FIXX(T)
15800		MOVEM T,KN#
15900					;	KL=Q(JJ-1)
16000		MOVE T,-3(JJ)
16100		FIXX(T)
16200	
16300		MOVEM T,KL#
16400					;	IF(KN.LT.KL)KN=KL
16500		CAMLE T,KN
16600		MOVEM T,KN
16700					; 50    I=J
16800	L50:	MOVEM J,I#
16900					; 102   RJ=I+.01
17000	L102:	MOVE RJ,I
17100		FLOAT(RJ)
17200		FADR RJ,[=0.01]
17300					;	ALT=HGHT(JJ,RJ,Q,R)
17400		MOVE AL,-2(JJ)
17600		CAMN AL,1(JJ)
17700		JRST RET2
17800		MOVNS AL
17900		FADR AL,1(JJ)
17950		MOVE D,-3(JJ)
18000		MOVNS T,D
18100		FADR T,RJ
18200		FADR D,(JJ)
18300		FMPR AL,T
18400		FDVR AL,D
18500		FADR AL,-2(JJ)
18600					;	B=-10000
18700	RET2:	MOVN B,[=10000.0]
18800					;	JK=-1
18900		SETO JK,
19000					;	XALT=ALT+.001
19100		MOVE T,AL
19200		FADR T,[=0.001]
19300		MOVEM T,XALT#
19400	
19500					;	ZALT=ALT
19600		MOVEM AL,ZALT#
19700					; 400   DO 47 L=2,KK
19800		MOVE L,SVQ
19900	L47:	ADDI L,3
20000		CAILE L,-2(KK)
20100		JRST L477
20200				;	IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20300		CAME L,JJ
20400		SKIPGE 2(L)
20500		JRST L47
20600		CAML RJ,-3(L)
20700		JRST L475
20800		CAMLE RJ,(L)
20900		JRST L476
21000	L475:	CAMGE RJ,(L)
21100		CAMG RJ,-3(L)
21200		JRST L47
21300					;	H=HGHT(L,RJ,Q,R)
21400	L476:	MOVE H,-2(L)
21500		CAMN H,1(L)
21700		JRST RET3
21800		MOVNS H
21900		FADR H,1(L)
21950		MOVE D,-3(L)
22000		MOVNS T,D
22100		FADR T,RJ
22200		FADR D,(L)
22300		FMPR H,T
22400		FDVR H,D
22500		FADR H,-2(L)
22600					;	IF(H.GT.XALT)GO TO 47
22700	RET3:	CAMG H,XALT
22800	
22900					;	IF(H.LE.B)GO TO 47
23000		CAMG H,B
23100		JRST L47
23200					;	B=H
23300		MOVE B,H
23400					;	JK=L
23500		HRRZI JK,(L)
23600					; 47    CONTINUE
23700		JRST L47
23800					;	IF(JK)GO TO 48
23900	L477:	JUMPL JK,L48
24000					;	300   IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24100		MOVN T,B
24200		FADR T,ZALT
24300		CAMG T,[=0.001]
24400		CAME J,I
24500		JRST L59
24600					;	JX=Q(JK)
24700		MOVE T,(JK)
24800		FIXX(T)
24900					;	IF(JX.GT.KN)GO TO 60
25000		CAMLE T,KN
25100		JRST L60
25200					;	JX=Q(JK-1)
25300		MOVE T,-3(JK)
25400		FIXX(T)
25500					;	IF(JX.LT.KN)GO TO 59
25600		CAMGE T,KN
25700		JRST L59
25800					; 60    L=JJ
25900	L60:	MOVE L,JJ
26000					;	JJ=JK
26100		MOVE JJ,JK
26200					;	JK=L
26300		MOVE JK,L
26400					;	KN=JX
26500		MOVEM T,KN
26600	
26700					; 59    IF(ALT-B.LT.2)GO TO 62
26800	L59:	MOVN T,B
26900		FADR T,AL
27000		CAMGE T,[=2.0]
27100		JRST L62
27200					;	ALT=ALT-1
27300		HRLZI T,576400
27400		FADR AL,T
27500					;	B=B+1
27600		HRLZI T,201400
27700		FADR B,T
27800					; 62    IF(JORD)GO TO 103
27900	L62:	SKIPGE JORD
28000		JRST L103
28100					;	H=B
28200		MOVE H,B
28300					;	B=ALT
28400		MOVE B,AL
28500					;	ALT=H
28600		MOVE AL,H
28700					;	IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28800	
28900		CAMN JK,NK#
29000		JRST L103
29100		MOVN T,B
29200		FADR T,AL
29300		SKIPGE T
29400		MOVNS T
29500		CAMG T,[5.0]
29600		JRST L103
29700		HRRZI T,3
29800		HRRZM T,JA
29900					; 103   CALL LINES(RJ,ALT,JA)
30000	L103:	MOVEM RJ,SVRJ#
30100		MOVEM AL,SVAL#
30200		MOVEM B,SVB#
30300		HRRZI 16,SVAC
30400		BLT 16,SVAC+15
30500		JSA 16,LINES
30600		JUMP SVRJ
30700		JUMP SVAL
30800		JUMP JA
30900					; 100   CALL LINES(RJ,B,2)	
31000		JSA 16,LINES
31100		JUMP SVRJ
31200		JUMP SVB 
31300		JUMP [2]
31400		HRLZI 16,SVAC
31500		BLT 16,15
31600					;	NK=JK
31700		MOVEM JK,NK
31800	
31900					;	JORD=-JORD
32000		MOVNS JORD
32100					;	NE(JK)=1
32200		HRRZI T,1
32300		HRRZM T,2(JK)
32400					;	NE(JJ)=-1
32500		SETOM 2(JJ)
32600					;	JA=2
32700		HRRZI T,2
32800		HRRZM T,JA
32900					;	I=I+M
33000		MOVE T,SVM
33100		ADDB T,I
33200					;	IF(I.LT.KN)GO TO 102
33300		CAMGE T,KN
33400		JRST L102
33500					;	L=1
33600		HRRZI L,3
33700					;	IF(KN.EQ.KL)L=-1
33800		MOVE T,KN
33900		CAMN T,KL
34000		HRROI L,-3
34100					;	JJ=JJ+L
34200		ADD JJ,L
34300					;	J=0
34400		SETZ J,
34500					;	IF(L)J=-1
34600		SKIPGE L
34700		HRROI J,-3
34800			;	IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34900		SKIPN 2(JJ)
35000		CAILE JJ,-2(KK)
35100		JRST L124
35200		ADD T,SVM
35250		FLOAT(T)
35300		HRRZI HG,(JJ)
35400		ADD HG,J
35500		CAMLE T,(HG)
35600		JRST L124
35700					;	J=I
35800		MOVE J,I
35900					;	GO TO 52
36000		JRST L52
36100					; 48    JA=3
36200	L48:	HRRZI T,3
36300		HRRZM T,JA
36400					; 43    J=LEFT+M
36500	L43:	MOVE J,LE
36600		ADD J,SVM
36700					;	IF(J.LE.LRT)GO TO 42
36800		CAMG J,LRT
36900		JRST L42
37000					;	IF(JCONT)GO TO 51
37100		SKIPGE JCONT
37200		JRST L51		;	END
37410		MOVE 16,SV16
37600		JRA 16,2(16)
37610	SVAC:	BLOCK 16
37700	
37800	
37900		EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT,.COMM.
38000			;	SUBROUTINE LINES(A,B,L)
38100			;	COMMON/DST/BB,CC
38200	   		;	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38300			;	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38400			;	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38500			;	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38600			;	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38700			;	1,(JJ2,JJ(2))
38800			;	DATA BB/.008/,CC/3.5/
38900	 		;C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
39000		
39400		M←2 ↔ N←3 ↔ K←4
39500	
39600	LINES:	0
39700				;	GO TO 23
39800		JRST L23
39900				;22	IF(JQ(1).NE.0)GO TO 23
40000	L22:	SKIPE PLTR+=27
40100		JRST L23
40200				;	IF(CC.EQ.1000)GO TO 23
40300		MOVSI T,212764
40400		CAMN T,DST+1
40500		JRST L23
40600				;	B=B*(CC-BB*ABS(A))
40700		MOVE T,@(16)
40900		MOVM	T,T
41000		FMPR T,DST
41100		FSBR T,DST+1
41200		FMPRM T,@1(16)
41300		MOVNS @1(16)
41400				;23	IF(IPLT)GO TO 2
41700				;	M=A*RSZ
41800	L23:	MOVE M,@(16)
41900		FMPR M,SIZ
42000		FIXX(M)
42100				;	N=B*RSZ
42200		MOVE N,@1(16)
42300		FMPR N,SIZ
42400		FIXX(N)
42500				;	IF(RSZ.LE.0.8571)GO TO 3
42600		MOVE T,[=0.8571]
42700		CAML T,SIZ
42800	;;	JRST L3
42850		JRST L6
42900	
42920		SUB M,SIZ+1		;	M=M-JCEN
43300		SUB N,SIZ+2		;	N=N-KCEN
43400				;	IF(JA.NE.8)GO TO 5
43500		MOVEI T,10
43600		CAME T,.COMM.+1
43700		JRST L5
43800				;	IF(M.GT.511)M=511
43900		CAMLE M,[=511]
44000		HRRZI M,=511
44100				;	IF(M.LT.-511)M=-511
44200		CAMGE M,[-=511]
44300		HRROI M,-=511
44400				;5	IF(IABS(M).GT.512)GO TO 77
44500	L5:	CAIG M,=512
44600		CAMGE M,[-=512]
44700		JRST L77
44800				;	IF(IABS(N).LT.512)GO TO 4
44900		CAIGE N,=512
45000		CAMG N,[-=512]
45100		CAIA
45200		JRST LL4
45300				;77	KZ=-1
45400	L77:	SETOM KZ#
45500				;	RETURN
45600		JRA 16,3(16)
45700				;4	IF(KZ.EQ.0)GO TO 6
45800	LL4:	SKIPN KZ
45900		JRST L6
46000				;	KZ=0
46100		SETZM KZ
46200		MOVEM M,MM#	;	GO TO 1
46300		MOVEM N,NN#
46400		JRST L1
46500				;3	IF(JA.EQ.44)GO TO 6
48500				;6	IF(JJ2.GT.3990)RETURN
48600	L6:   	MOVEI T,7626
48700		CAMGE T,DPY+1
48800		JRA 16,3(16)
48900				;	IF(L.EQ.3)GO TO 1
49000		MOVEM M,MM
49100		MOVEM N,NN
49200		HRRZI T,3
49300		CAMN T,@2(16)
49400		JRST L1
49500				;	CALL AVECT(M,N)
49600		JSA 16,AVECT
49700		JUMP MM
49800		JUMP NN
49900				;	RETURN
50000		JRA 16,3(16)
50100				;1	CALL AIVECT(M,N)
50200	L1:   	JSA 16,AIVECT
50300		JUMP MM
50400		JUMP NN
50500				;	RETURN
50600		JRA 16,3(16)
50700				;2	IF(IPLT.EQ.-2)RETURN
50800	;;L2:   	MOVNI T,2
50900	;;	CAMN T,PLTR
51000	;;	JRA 16,3(16)
53600		END